Option Explicit
'ۭqҲ
Private WithEvents myForm As UfFocusCK
Private Sub UserForm_Initialize()
    Set myForm = New UfFocusCK
End Sub

Private Sub UserForm_Activate()
    myForm.RFlg = True
    myForm.Actck Me
End Sub

Private Sub myForm_MoveFocus(ExitControl As String, EnterControl As String)
    MsgBox ExitControl & "" & EnterControl
End Sub

Private Sub UserForm_Deactivate()
    myForm.RFlg = False
End Sub

Private Sub UserForm_Terminate()
    myForm.RFlg = False
    Set myForm = Nothing
End Sub

'OҲUfFocusCK
Private RunFlg As Boolean
Private ExitControl As String
Private EnterControl As String
Public Event MoveFocus(ExitControl As String, EnterControl As String)
Public Property Get RFlg() As Boolean
      RFlg = RunFlg
End Property

Public Property Let RFlg(myFlg As Boolean)
      RunFlg = myFlg
End Property

Public Sub Actck(myForm As MSForms.UserForm)
    ExitControl = ActCntck(myForm)
    On Error GoTo errlabel
    Do While RunFlg
        DoEvents
        EnterControl = ActCntck(myForm)
        If EnterControl = "" Then GoTo errlabel
        If ExitControl <> EnterControl Then
            myForm.Controls(EnterControl).SetFocus
            RaiseEvent MoveFocus(ExitControl, EnterControl)
            ExitControl = EnterControl
        End If
    Loop
errlabel:
    Exit Sub
End Sub

Private Function ActCntck(myForm As MSForms.UserForm) As String
    Dim myCnt1 As MSForms.Control
    Dim myCnt2 As MSForms.Control
    On Error Resume Next
        Set myCnt1 = myForm.ActiveControl
    On Error GoTo 0
    If myCnt1 Is Nothing Then GoTo errlabel
    Select Case TypeName(myCnt1)
        Case "MultiPage" ', "TabStrip"
            Set myCnt1 = myCnt1.SelectedItem
    End Select
    Do
      Set myCnt2 = Nothing
        On Error Resume Next
            Set myCnt2 = myCnt1.ActiveControl
        On Error GoTo 0
        If myCnt2 Is Nothing Then Exit Do
        Set myCnt1 = myCnt2
    Loop Until myCnt2 Is Nothing
    ActCntck = myCnt1.Name
    Exit Function
errlabel:
    ActCntck = ""
    Exit Function
End Function
